home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / util / sort.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  2.7 KB  |  73 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. signature SORT =
  3.   sig
  4.     (* pass the gt predicate as an argument *)
  5.      val sort : ('a * 'a -> bool) -> 'a list -> 'a list  
  6.      val sorted : ('a * 'a -> bool) -> 'a list -> bool  
  7.   end
  8.  
  9. structure Sort : SORT = struct
  10.  
  11. (* Industrial-strength quicksort.
  12.    Selects pivot from middle of input list.
  13.    Distributes elements equal to pivot "randomly" in the two output partitions.
  14.    Special-cases lists of 0, 1, or 2 elements.
  15. *)
  16. fun sort (op > : ('x * 'x -> bool)) =
  17.   let fun splita(pivot,nil,less,greater)= qsort less @ (pivot :: qsort greater)
  18.         | splita(pivot,a::rest,less,greater) =
  19.                  if a>pivot then splitb(pivot,rest,less,a::greater)
  20.                     else splitb(pivot,rest,a::less,greater)
  21.       and splitb(pivot,nil,less,greater)= qsort less @ (pivot :: qsort greater)
  22.         | splitb(pivot,a::rest,less,greater) =
  23.                  if pivot>a then splita(pivot,rest,a::less,greater)
  24.                     else splita(pivot,rest,less,a::greater)
  25.       and split1a(pivot,0,_::r,less,greater) = splitb(pivot,r,less,greater)
  26.         | split1a(pivot,i,a::rest,less,greater) =
  27.                  if a>pivot then split1b(pivot,i-1,rest,less,a::greater)
  28.                     else split1b(pivot,i-1,rest,a::less,greater)
  29.       and split1b(pivot,0,_::r,less,greater) = splita(pivot,r,less,greater)
  30.         | split1b(pivot,i,a::rest,less,greater) =
  31.                  if pivot>a then split1a(pivot,i-1,rest,a::less,greater)
  32.                     else split1a(pivot,i-1,rest,less,a::greater)
  33.       and qsort (l as [a,b]) = if a>b then [b,a] else l
  34.         | qsort (l as _::_::_) = 
  35.            let fun getpivot (x::xr, _::_::rest, i) = getpivot(xr,rest,i+1)
  36.                  | getpivot (x::_, _,i) = split1a(x,i,l,nil,nil)
  37.             in getpivot(l,l,0)
  38.            end
  39.         | qsort l = l
  40.   in qsort
  41.   end
  42.  
  43. (* smooth applicative merge sort
  44.  * Taken from, ML for the Working Programmer, LCPaulson. pg 99-100
  45.  *)
  46. fun sort (op > : 'a * 'a -> bool) ls = 
  47.     let fun merge([],ys) = ys
  48.       | merge(xs,[]) = xs
  49.       | merge(x::xs,y::ys) = 
  50.         if x > y then y::merge(x::xs,ys) else x::merge(xs,y::ys)
  51.     fun mergepairs(ls as [l], k) = ls
  52.       | mergepairs(l1::l2::ls,k) = 
  53.         if k mod 2 = 1 then l1::l2::ls
  54.         else mergepairs(merge(l1,l2)::ls, k div 2)
  55.     fun nextrun(run,[])    = (rev run,[])
  56.       | nextrun(run,x::xs) = if x > hd run then nextrun(x::run,xs)
  57.                  else (rev run,x::xs)
  58.     fun samsorting([], ls, k)    = hd(mergepairs(ls,0))
  59.       | samsorting(x::xs, ls, k) = 
  60.         let val (run,tail) = nextrun([x],xs)
  61.         in samsorting(tail, mergepairs(run::ls,k+1), k+1)
  62.         end
  63.     in case ls of [] => [] | _ => samsorting(ls, [], 0)
  64.     end
  65.  
  66. fun sorted (op >) =
  67.   let fun s (x::(rest as (y::_))) = not(x>y) andalso s rest
  68.         | s l = true
  69.   in s
  70.   end
  71.  
  72. end
  73.